home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / BUSITION / SMARKET2.LZH / HLRB.EXE / HLRB.PAS < prev    next >
Pascal/Delphi Source File  |  1991-08-08  |  13KB  |  390 lines
  1. PROGRAM Hlrb;  { Print out the Handy Little Reference Books }
  2.  
  3. USES CRT, DOS, PRINTER;
  4.  
  5. {
  6.   ┌─────────────────────────────────────────────────────────────┬───────────┐
  7.   │  Pinnacle  Software's  Handy Little Reference Book Printer  │  H L R B  │
  8.   ├─────────────────────────────────────────────────────────────┴───────────┤
  9.   │  C O P Y R I G H T  (C)  1989  BY   P I N N A C L E    S O F T W A R E  │
  10.   │  P.O. Box  386, Town of Mount Royal, Montreal, Quebec, Canada  H3P 3C6  │
  11.   ├─────────────────────────────────────────────────────────────────────────┤
  12.   │  Permission is  hereby given to distribute this Pinnacle product, pro-  │
  13.   │  vided that  it is distributed in its  complete  and  unaltered  form,  │
  14.   │  including all  programs, text and data.                                │
  15.   └─────────────────────────────────────────────────────────────────────────┘
  16. }
  17.  
  18. TYPE
  19.   String80 = STRING[80];
  20.  
  21. {
  22.   V1.10 TP4 upgrade, printer-not-ready fix
  23.   V1.20 TP5 upgrade, double-line-print fix
  24. }
  25.  
  26. CONST
  27.   Ver : STRING[7] = ' 1.20AA';
  28.   Co  : STRING[40] = 'Copyright (C) 1986,91 Pinnacle Software';
  29.  
  30. VAR  { Working Variables }
  31.   Completed  : BOOLEAN;
  32.   InChar     : CHAR;
  33.   Indent     : INTEGER;
  34.   IORes      : INTEGER;
  35.   PrintFile  : STRING[64];
  36.   TextLine   : STRING[255];
  37.   VALRetCode : INTEGER;
  38.   Width      : INTEGER;
  39.  
  40. VAR  { Files }
  41.   TxtFile : TEXT;
  42.  
  43. {===== Utility Processors =====}
  44.  
  45. PROCEDURE PressKey;
  46. BEGIN
  47.   WRITELN;
  48.   WRITE('Press a key to continue... ');
  49.   InChar := READKEY;
  50.   WRITELN;
  51. END;
  52.  
  53. FUNCTION Upper(UStr : String80) : String80;
  54. VAR
  55.   UCntr : INTEGER;
  56. BEGIN
  57.   FOR UCntr := 1 TO LENGTH(UStr) DO UStr[UCntr] := UPCASE(UStr[UCntr]);
  58.   Upper := UStr;
  59. END; { Function Upper }
  60.  
  61. {$I DIR.INC}
  62.  
  63. {===== Mainline Processors =====}
  64.  
  65. PROCEDURE StartUp;
  66. BEGIN
  67.   CLRSCR;
  68.   Completed := FALSE;
  69.   Indent := 0;
  70.   IF LENGTH(PARAMSTR(1)) = 0 THEN
  71.   BEGIN
  72.     WRITELN('  ╔═══════╤═══════════════════════════════════════════════╤═══════╗');
  73.     WRITELN('  ║░░░░░░░│█▀▀▀████▀▀█ █▀▀▀███████ █▀▀▀▀▀▀▀▀▀█ █▀▀▀▀▀▀▀▀██│░░░░░░░║ ░░');
  74.     WRITELN('  ║░▒▒▒▒▒▒│█   ████  █ █   ███████ █   ▄▄▄▄  █ █   ▄▄▄  ██│░▒▒▒▒▒▒║ ░░');
  75.     WRITELN('  ║░▒▒▓▒▒▒│█         █ █   ███████ █         █ █         █│░▒▒▓▒▒▒║ ░░');
  76.     WRITELN('  ║░▒▒▒▒▒▒│█   ████  █ █   ▀▀▀▀▀▀█ █   ██   ██ █   ▀▀▀▀  █│░▒▒▒▒▒▒║ ░░');
  77.     WRITELN('  ║░▒▒▒▒▒▒│█▄▄▄████▄▄█ █▄▄▄▄▄▄▄▄▄█ █▄▄▄██▄▄▄▄█ █▄▄▄▄▄▄▄▄▄█│░▒▒▒▒▒▒║ ░░');
  78.     WRITELN('  ╠═══════╪═══════════════════════════════════════════════╪═══════║ ░░');
  79.     WRITELN('  ║░░░░░░░│   HANDY      LITTLE     REFERENCE     BOOKS   │░░░░░░░║ ░░');
  80.     WRITELN('  ╠═══════╪═══════════════════════════════════════════════╪═══════║ ░░');
  81.     WRITELN('  ║░░░░░░░│      Entire product, Copyright (C) 1989       │░░░░░░░║ ░░');
  82.     WRITELN('  ║░▒▒▒▒▒▒│      ∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙       │░▒▒▒▒▒▒║ ░░');
  83.     WRITELN('  ║░▒▒▓▒▒▒│      P I N N A C L E    S O F T W A R E       │░▒▒▓▒▒▒║ ░░');
  84.     WRITELN('  ║░▒▒▒▒▒▒│      P.O. Box 386,  Town of Mount Royal       │░▒▒▒▒▒▒║ ░░');
  85.     WRITELN('  ║░▒▒▒▒▒▒│      Montreal, Quebec,  Canada  H3P 3C6       │░▒▒▒▒▒▒║ ░░');
  86.     WRITELN('  ╠═══════╧═══════════════════════════════════════════════╧═══════║ ░░');
  87.     WRITELN('  ║        VERSION    REVISION      PACKAGE    INTERNAL ID        ║ ░░');
  88.     WRITE  ('  ║         ',Ver[1],' ',Ver[2]);
  89.     WRITE  ('          ',Ver[4],Ver[5]);
  90.     WRITE  ('            ',Ver[6]);
  91.     WRITE  ('            ',Ver[7]);
  92.     WRITELN('             ║ ░░');
  93.     WRITELN('  ╚═══════════════════════════════════════════════════════════════╝ ░░');
  94.     WRITELN('    ░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░');
  95.     WRITELN;
  96.     WRITELN('    If you  find  this  product  useful,  please  drop us a line,  or');
  97.     WRITELN('    refer to the documentation  for information  about extra support.');
  98.     WRITELN;
  99.     WRITE('    Press a key to begin... ');
  100.     InChar := READKEY;
  101.   END;  { No parameter at start-up }
  102. END;  { StartUp }
  103.  
  104. FUNCTION GetFileName : BOOLEAN;
  105. VAR
  106.   GFNOkay : BOOLEAN;
  107.   GotName : BOOLEAN;
  108. BEGIN
  109.   PrintFile := PARAMSTR(1);
  110.   GotName := FALSE;
  111.   GFNOkay := FALSE;
  112.   REPEAT
  113.     IF LENGTH(PrintFile) = 0
  114.     THEN
  115.     BEGIN
  116.       CLRSCR;
  117.       WRITELN('List of Handy Little Reference Books');
  118.       WRITELN('────────────────────────────────────');
  119.       WRITELN;
  120.       ShowFiles('HLB');
  121.       WRITELN;
  122.       WRITELN('Type the name of the book you want to print');
  123.       WRITELN('or press ENTER to quit without printing.');
  124.       WRITELN;
  125.       WRITE('Which book?  ');
  126.       READLN(PrintFile);
  127.       PrintFile := UPPER(PrintFile);
  128.       IF LENGTH(PrintFile) = 0
  129.       THEN GotName := TRUE;
  130.     END;
  131.     IF LENGTH(PrintFile) > 0 THEN
  132.     BEGIN
  133.       IF POS('.',PrintFile) = 0 THEN PrintFile := PrintFile + '.HLB';
  134.       {$I-}
  135.       ASSIGN(TxtFile,PrintFile);
  136.       RESET(TxtFile);
  137.       IORes := IORESULT;
  138.       {$I+}
  139.       IF IORes = 0
  140.       THEN
  141.       BEGIN
  142.         GFNOkay := TRUE;
  143.         GotName := TRUE;
  144.       END
  145.       ELSE
  146.       BEGIN
  147.         WRITELN;
  148.         WRITELN(PrintFile,' was not found.');
  149.         PressKey;
  150.         PrintFile := '';
  151.       END;
  152.     END;  { Input length > 0 }
  153.   UNTIL GotName;
  154.   GetFileName := GFNOkay;
  155. END; { Procedure GetFileName }
  156.  
  157. PROCEDURE ShowAlign;
  158. VAR
  159.   IndOkay   : BOOLEAN;
  160.   IndString : STRING[3];
  161. BEGIN
  162.   {----- Show picture if no alignment -----}
  163.   IF Indent = 0 THEN
  164.   BEGIN
  165.     WRITELN('Insert the sheet into the printer.  Align the paper so');
  166.     WRITELN('columns 1 and ',Width,' are an equal distance from the edges.');
  167.     WRITELN;
  168.     WRITELN('           1        ',Width);
  169.     WRITELN('           |        |');
  170.     WRITELN('         ┌────────────┐');
  171.     WRITELN('         │ ┌────────┐ │');
  172.     WRITELN('  ╓──┬──┬│ :        : │───────┬──┬──╖');
  173.     WRITELN('(║│  │  ╘┴─╨──────────┴═══════╛  │  │║)');
  174.     WRITELN('  ╞══╧═══════════════════════════╧══╡');
  175.     WRITELN('  │                    [─] [─] [─]  │');
  176.     WRITELN('  ╘─────────────────────────────────╛');
  177.   END;
  178.   IndOkay := FALSE;
  179.   {----- Get alignment if desired -----}
  180.   REPEAT
  181.     WRITELN;
  182.     IF Indent = 0
  183.     THEN
  184.     BEGIN
  185.       WRITELN('Press  ENTER  if you''ve aligned the paper this way, or type');
  186.       WRITE  ('the number of spaces you want to indent (move over) the page.  ');
  187.     END
  188.     ELSE
  189.     BEGIN
  190.       WRITELN('Press ENTER to indent the page ',Indent,' spaces,');
  191.       WRITE(  'or type a new indent value.  ');
  192.     END;
  193.     READLN(IndString);
  194.     WRITELN;
  195.     IF LENGTH(IndString) = 0
  196.     THEN IndOkay := TRUE
  197.     ELSE
  198.     BEGIN
  199.       VAL(IndString,Indent,VALRetCode);
  200.       IF VALRetCode = 0
  201.       THEN IndOkay := TRUE
  202.       ELSE WRITELN('Please type a number or press ENTER.');
  203.     END
  204.   UNTIL IndOkay;
  205.   CLRSCR;
  206.   WRITELN('Now roll back the sheet to leave half an inch at the top.');
  207.   WRITELN;
  208.   WRITELN;
  209.   WRITELN('          Half an inch');
  210.   WRITELN('  ╓──┬──┬┌────────────┐───────┬──┬──╖');
  211.   WRITELN('(║│  │  ╘┴─╨──────────┴═══════╛  │  │║)');
  212.   WRITELN('  ╞══╧═══════════════════════════╧══╡');
  213.   WRITELN('  │                    [─] [─] [─]  │');
  214.   WRITELN('  ╘─────────────────────────────────╛');
  215.   PressKey;
  216.   CLRSCR;
  217. END;
  218.  
  219. PROCEDURE Prt(PLine : String80);
  220. BEGIN
  221.   {$I-}
  222.   REPEAT
  223.     WRITELN(LST,PLine);
  224.   UNTIL IORESULT = 0;
  225.   {$I+}
  226. END;
  227.  
  228. PROCEDURE PrtLn(PLine : String80);
  229. BEGIN
  230.   Prt(PLine);
  231. END;
  232.  
  233. PROCEDURE DoPrint;
  234. VAR
  235.   Aborted : BOOLEAN;
  236.   Done    : BOOLEAN;
  237.   IndCntr : INTEGER;
  238. BEGIN
  239.   IF EOF(TxtFile)
  240.   THEN
  241.   BEGIN
  242.     WRITELN('That booklet file is empty.');
  243.   END
  244.   ELSE
  245.   BEGIN
  246.     READLN(TxtFile,TextLine);
  247.     Width := LENGTH(TextLine);
  248.     Completed := FALSE;
  249.     Done := FALSE;
  250.     REPEAT
  251.       RESET(TxtFile);
  252.       CLRSCR;
  253.       ShowAlign;
  254.       CLRSCR;
  255.       WRITELN('Press  P  to pause printing.');
  256.       WRITELN('Press  R  to restart printing.');
  257.       WRITELN('Press  C  to cancel printing.');
  258.       WRITELN;
  259.       Aborted := FALSE;
  260.       REPEAT
  261.         READLN(TxtFile,TextLine);
  262.         IF POS('<<NEW PAGE>>',TextLine) = 1 THEN
  263.         BEGIN
  264.           CLRSCR;
  265.           WRITELN;
  266.           WRITELN('╔═════════════╗  Take the sheet out and');
  267.           WRITELN('║  NEW  PAGE  ║  flip it over so we can');
  268.           WRITELN('╚═════════════╝  print on the back.');
  269.           WRITELN;
  270.           ShowAlign;
  271.         END
  272.         ELSE
  273.         BEGIN
  274.           WRITELN(TextLine);
  275.           IF KEYPRESSED THEN
  276.           BEGIN
  277.             InChar := READKEY;
  278.             InChar := UPCASE(InChar);
  279.             CASE InChar OF
  280.               'P' : BEGIN
  281.                       PressKey;
  282.                       WRITELN;
  283.                     END;
  284.               'R' : BEGIN
  285.                       Aborted := TRUE;
  286.                       Completed := FALSE;
  287.                       Done := FALSE;
  288.                     END;
  289.               'C' : BEGIN
  290.                       Aborted := TRUE;
  291.                       Completed := FALSE;
  292.                       Done := TRUE;
  293.                     END;
  294.             END;
  295.           END;
  296.           IF Indent > 0 THEN FOR IndCntr := 1 TO Indent DO Prt(' ');
  297.           PrtLn(TextLine);
  298.         END;
  299.         IF EOF(TxtFile) THEN
  300.         BEGIN
  301.           Aborted := TRUE;
  302.           Completed := TRUE;
  303.           Done := TRUE;
  304.         END;
  305.       UNTIL Aborted;  { Loop through file lines }
  306.     UNTIL Done;  { Loops through re-prints }
  307.   END;  { File not empty }
  308. END; { Procedure PrintFile }
  309.  
  310. PROCEDURE ShowAssembly;
  311. BEGIN
  312.   CLRSCR;
  313.   WRITE('Do you want instructions for assembling the book?  (Y/N)  ');
  314.   REPEAT
  315.     InChar := READKEY;
  316.     InChar := UPCASE(InChar);
  317.   UNTIL InChar IN ['Y','N'];
  318.   IF InChar = 'Y' THEN
  319.   BEGIN
  320.     CLRSCR;
  321.     WRITELN('Fold the sheet down the middle, between the double line.');
  322.     WRITELN('The  Title Page  should be on the  outside  of the fold.');
  323.     WRITELN;
  324.     WRITELN('┌───────────────────┐              ┌─────────┐');
  325.     WRITELN('│ ┌───────╥───────┐ │              ├───────┐ │');
  326.     WRITELN('│ │       ║ TITLE │ │              │ TITLE │ │');
  327.     WRITELN('│ ├───────╫───────┤ │              ├───────┤ │');
  328.     WRITELN('│ │       ║       │ │              │       │ │');
  329.     WRITELN('│ ├───────╫───────┤ │    ═════>    ├───────┤ │');
  330.     WRITELN('│ │       ║       │ │              │       │ │');
  331.     WRITELN('│ ├───────╫───────┤ │              ├───────┤ │');
  332.     WRITELN('│ │       ║       │ │              │       │ │');
  333.     WRITELN('│ └───────╨───────┘ │              ├───────┘ │');
  334.     WRITELN('└───────────────────┘              └─────────┘');
  335.     PressKey;
  336.     CLRSCR;
  337.     WRITELN('Press the sheet VERY flat and then trim off the borders.');
  338.     WRITELN;
  339.     WRITELN('                         ┌───────┐    ');
  340.     WRITELN('┌─────────┐              └───────┘ ┌─┐');
  341.     WRITELN('├───────┐ │              ┌───────┐ │ │');
  342.     WRITELN('│ TITLE │ │              │ TITLE │ │ │');
  343.     WRITELN('├───────┤ │        Don''t ├───────┤ │ │');
  344.     WRITELN('│       │ │          cut │       │ │ │');
  345.     WRITELN('├───────┤ │         here ├───────┤ │ │');
  346.     WRITELN('│       │ │              │       │ │ │');
  347.     WRITELN('├───────┤ │    ═════>    ├───────┤ │ │');
  348.     WRITELN('│       │ │              │       │ │ │');
  349.     WRITELN('├───────┘ │              └───────┘ │ │');
  350.     WRITELN('└─────────┘              ┌───────┐ └─┘');
  351.     WRITELN('                         └───────┘    ');
  352.     PressKey;
  353.     CLRSCR;
  354.     WRITELN('Cut off each double page and tuck it in the middle.');
  355.     WRITELN;
  356.     WRITELN('┌───────┐');
  357.     WRITELN('│ TITLE │ 1 ═════>     ┌───────┐');
  358.     WRITELN('├───────┤              │ TITLE ├─┐');
  359.     WRITELN('│       │ 2 ═══════>   ├─┬─────┘ ├─┐');
  360.     WRITELN('├───────┤              │ ├─┬─────┘ ├─┐');
  361.     WRITELN('│       │ 3 ═════════>   │ ├─┬─────┘ │');
  362.     WRITELN('├───────┤                  │ ├───────┘');
  363.     WRITELN('│       │ 4 ═══════════>     │');
  364.     WRITELN('└───────┘');
  365.     PressKey;
  366.     CLRSCR;
  367.     WRITELN('Now put two staples in the spine -- and you''re done!');
  368.     WRITELN;
  369.     WRITELN('       ┌───────────────╥───────────────┐');
  370.     WRITELN('┌────────────────────────┐             │');
  371.     WRITELN('╞═══════════════════════╤╛   TITLE     │');
  372.     WRITELN('└┬───┬──────────────────╛              │');
  373.     WRITELN(' │   ╘─└───────────────╨───────────────┘');
  374.     WRITELN(' ╘──────────────────────╛');
  375.     WRITELN(' Stapler');
  376.     PressKey;
  377.     WRITELN;
  378.     WRITELN('Enjoy your Handy Little Reference Book!');
  379.     WRITELN;
  380.   END;
  381. END;
  382.  
  383. {===== Mainline Code =====}
  384.  
  385. BEGIN
  386.   StartUp;
  387.   IF GetFileName THEN DoPrint;
  388.   IF Completed THEN ShowAssembly;
  389. END.
  390.